COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE WRTPAG
C00016 ENDMK
C⊗;
	SUBROUTINE WRTPAG
	DATA SLSP/12.0/
	COMMON /FIN/JBAR,NPX,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
	1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
	1 /SF/KL,RT,KP,STFSZ,NAMX,EXT /IPG/IPG
	1 ,JPG,BRACK(-3/4),RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) 
	1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T /KBAR/KBAR(512)
 	1 /RCLF/KK,CL,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,ITR
	COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
	COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1)
	COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
	1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(1)
	DIMENSION ENDSTF(450),KPTR(50)
C  ENDSTF AND ENDPTR FOR CARRYING STUFF FROM ONE LINE TO THE NEXT.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R7,RQ(5))
	1,(R8,RQ(6)),(LCNT,IV(45)),(NDPY,IV(46)),(ENDSTF,KBAR(4))
	NPG=1
	NMPG='PAGEA'
	HORZ=96.
	RNUM=0.
	LB=0
	ITR=LL
C TRANSPOSE IS IN LL
	RA=0
	JEND=-1
	METR=1000
	CLEF=-99
	JSLUR=0
	LC=1
	KREAD=128
	SIG=CLEF
	HX=2
	KQ=1
	KPX=1
	CALL FILOUT
C NAMQ AND NPG ARE SET IN FILOUT  
	SP=2.45
C  DEFAULT VERT. SPACE UNITS
	ENDSTF(1)=0
	IF(N.EQ.0)GO TO 100
C  SPACED OUT DEPENDING ON NUM OF LINES
	HX=N
	SP=SP+(HX-2.)*.11

100	CALL FILEIN

320	CALL STAVES
CC	IF(IPG)GO TO 3000
	IF(NPG.NE.1)GO TO 3000
	RT=RSTNUM(JPG)
	RS=100.+HORZ
	HORZ=-HORZ
	RNUM=RNUM+1
C ADDS PAGE NUMBER.
	CALL STAFF(4.,10.,RS,28.,RNUM,1.1,0,0,0,0,0,0)
3000	IF(ITR.NE.0)CALL TRNSP
	JPQ=KL

	NA=0
	KPT=1
	ENDSTF(1)=0
C  LOOP STARTS HERE *******
131	NA=NA+1
	KWDS(KP)=JPQ
	KP=KP+1
	R=CODEN(KPN,NA,Q,JK)
	RR=Q(JK+6)
	RS=Q(JK)
	IF(R.NE.5)GO TO 935
	R8=-1
	IF(RS.GE.6)R8=Q(JK+8)
	IF(RR)GO TO 735
	IF(RR.LE.Q(JK+3))RR=202.
	GO TO 235
C CATCHES SLURS, TRILLS, 8VA, LINES THAT GO PAST END OF LINE.
935	IF(R.EQ.7)GO TO 835
	IF(R.NE.44)GO TO 35
	R=R/11.
	Q(JK+1)=R
C  INFOR FOR P9 AND L10 OF DASHES AND WIGGLES NOT KEPT YET!!!!!!!
	IF(RR.LT.Q(JK+3))GO TO 30
C  NEEDED WHEN DATA ON LINE HAS BEEN EXPANDED, NOT CONTRACTED.
835	R8=0
	R7=0
	IF(RS.GE.6)R8=Q(JK+8)
235	IF(RR.LT.199.)GO TO 30
C  P1,P2,P3,P4,P5,P6,P7,P8  ARE SAVED.
	RR=-1
735	IF(RS.GE.5)R7=Q(JK+7)
	ENDSTF(KPT)=6
	ENDSTF(KPT+1)=R
	C=Q(JK+2)
	ENDSTF(KPT+2)=C
	ENDSTF(KPT+3)=1
	ENDSTF(KPT+4)=Q(JK+4)
	ENDSTF(KPT+5)=Q(JK+5)
	ENDSTF(KPT+7)=R7
	ENDSTF(KPT+8)=R8
 	ENDSTF(KPT+6)=RR
CX	A=Q(JK+6)
CX	B=0
CX	R7=0
CX	DO 136 K=NA+1,NPX
C THIS LOOP GETS NOTE POS. OF RIGHT SIDE OF SLUR.
CX	KK=KPN(K)
CX	R=Q(KK+1)
CX	IF(R.NE.1)GO TO 136
CX	IF(C.NE.Q(KK+2))GO TO 136
CX	B=B+1
CX	R8=Q(KK+3)
C FIND NOTE BEFORE AND AFTER RIGHT END OF SLUR
CX	IF(R8.LE.A)GO TO 336 
CX	ENDSTF(KPT+6)=-B+(R8-A)/(R8-R7)
C SAVE NEG. NOTE COUNT.  POSITIVE WILL ALWAYS BE 12.
CX	GO TO 236
CX336	R7=R8
C  FIND POS OF NOTE JUST BEFORE POINT.
CX136	CONTINUE

236	KPT=KPT+13
	ENDSTF(KPT)=0
	Q(JK+6)=202
	GO TO 30
C*************
35	IF(R.NE.2)GO TO 36
	IF(RS.LT.6.)GO TO 30
CC	R=Q(JK+2)
C  THE STAFF NUM.
CC	DO 134 K=NA-1,1,-1
CC	R8=CODEN(KPN,K,Q,LL)
CC	IF(R8.EQ.4)GO TO 234
CC	IF(Q(LL+2).NE.R)GO TO 134
CC	IF(R8.LT.10)GO TO 234
CC134 	CONTINUE
C NOW FOUND ITEM TO LEFT ON THIS STAFF.
CC234	RR=Q(LL+3)
CC	DO 334 K=NA+1,I
CC	R8=CODEN(KPN,K,Q,LL)
CC	IF(R8.EQ.4)GO TO 434
CC	IF(Q(LL+2).NE.R)GO TO 334
CC	IF(R8.LT.10)GO TO 434
CC334 	CONTINUE
CC434	RS=Q(LL+3)
C NOW FOUND ITEM TO RIGHT ON THIS STAFF.

	RR=RIGHT(NA,-1,JK)
CR	IF(RR.GE.199.)RR=RX
	Q(JK+3)=RR-1.6*RSTJ2+(RIGHT(NA,1,JK)-RR)/2.
C  FUNCTION 'RIGHT' FINDS ITEMS TO LFT AND RT OF REST FOR CENTERING.
C CENTERS WHOLE REST
	GO TO 30
36	IF(R.NE.3)GO TO 34
	CLEF=CLEFN(Q,JK)
CPT	IF(IPG)GO TO 30  
	LL=Q(JK+2)
C GETS CLEF FOR PAGE LAYOUT
	RCLEF(LL)=CLEF
	GO TO 30
34	IF(R.NE.17)GO TO 37
	SIG=Q(JK+5)
	IF(ABS(SIG).GT.100.)SIG=-99
C  DO NOT REPEAT KSIG MADE UP OF NATURALS.
CXX	IF(Q(JK).GT.3)SIG=SIG+Q(JK+6)*100.
CXX  CLEF # IN P6 WITH KEY SIGS.
C  NEXT CHANGES CODE NUM BACK TO ORIGINAL
37	IF(R.LT.33)GO TO 130
38	Q(JK+1)=R/11.
	GO TO 30
130	IF(Q(JK+3).LT.199)GO TO 30
	IF(R.NE.18)GO TO 30
	KKK=K+1
	R3=9
	IF(SIG.NE.-99)R3=14
	KK=JK
CC435	R8=0
CC	R9=0
CC	R10=0
435	LL=KPN(KKK)
C  WDCNT,P1,P2,P3,P4,P5,P6,P7,P8
	ENDSTF(KPT)=Q(KK)
	ENDSTF(KPT+1)=R
	ENDSTF(KPT+2)=Q(KK+2)
	ENDSTF(KPT+3)=R3
CC	ENDSTF(KPT+4)=Q(KK+4)
CC	ENDSTF(KPT+5)=Q(KK+5)
CC	ENDSTF(KPT+6)=Q(KK+6)
CC	ENDSTF(KPT+7)=0
CC	ENDSTF(KPT+8)=0 
	DO 535 JJ2=4,12
535	ENDSTF(KPT+JJ2)=Q(KK+JJ2)
	KPT=KPT+13
	ENDSTF(KPT)=0

	RS=Q(LL+1)
	IF(RS.LE.4)GO TO 30
	R4=Q(LL+2)
C  SAVE THE STAFF NUM. IN R4
	IF(RS.NE.18)GO TO 7011
335	R3=R3+6
	KK=LL
	KKK=KKK+1
	GO TO 435
7011	RS=CODEN(KPN,KKK+1,Q,LL)
	IF(RS.LE.4)GO TO 30
	IF(Q(LL+2).NE.R4)GO TO 30
	IF(RS.EQ.18)GO TO 335
30	JPQ=KPN(NA+1)-KPN(NA)+JPQ
	IF(NA.LT.I)GO TO 131
C  END OF LOOP ****************

	CALL PSHFT(I)
	RS=RT
	LL='J'
	R4=0
	R5=200
	NA=L
	L=KP-1 
	CALL PTMOVE(RN,KWDS(1))

C  START LAST LOOP *******
	DO 47 JJ2=1,KP
	LL=KWDS(JJ2)
	AA=RN(LL+1)
	IF(AA.NE.10.AND.AA.NE.16)GO TO 1047
CN	IF(AA.NE.10.AND.AA.NE.16)GO TO 347
	DO 147 NN=JJ2+1,KP
	MM=KWDS(NN)
	IF(RN(MM+1).NE.16)GO TO 147
C  FOUND THE NEXT TEXT AFTER TEXT OR NUMB.
	IF(RN(MM).EQ.8)GO TO 47
C  JUMP IF POS. IS ALREADY TAKEN CARE OF.
	IF(AA.EQ.10)GO TO 247
C NEXT FOR TEXT FOLLOWING TEXT
	IF(ABS(RN(MM+4)-RN(LL+4)).GE.4)GO TO 47
C JUMP IF ON DIFF. VERT. PLANE.
	AA=(RN(LL+9)+4.)*RSTJ2*RN(LL+5)+RN(LL+3)
C  SETS MINIMUM SPACE.
	IF(RN(MM+3).LT.AA)RN(MM+3)=AA
	GO TO 47
247	IF(ABS(RN(MM+4)-RN(LL+4)).GT.6)GO TO 47
C  CHECKS VERT. POS.
	AA=RN(LL+4)+7
	IF(RN(MM+4)-AA.LT.0)RN(MM+4)=AA
C  MOVE WORD TO RIGHT OF NUMBER IF IT WAS TOO CLOSE
	GO TO 47
147	CONTINUE
	GO TO 47
CN347	IF(AA.NE.5)GO TO 1047
C TO IMPROVE SLUR PARAMETERS
CN	R8=RN(LL+8)
CN	IF(RN(LL).LT.6)R8=0
CN	IF(R8.GT.0)GO TO 47
C  JUMP IF A BRACKET
CN	R=RN(LL+6)

CN	DO 647 NN=JJ2+1,KP
CN	MM=KWDS(NN)
C  THIS IS TO FIND SLURS AT END OF OLD LINES AND EXTEND THEM
CN	IF(RN(MM+1).NE.4)GO TO 647
C FIND A BAR LINE
CN	IF(RN(MM+3).GT.199.)GO TO 647
C  IGNORE LAST BAR OR LINE.
CN	IF(RN(MM).GT.2)GO TO 647
CN	AA=ABS(RN(MM+3)-R)
CN	IF(AA.GT.1.)GO TO 647
CN	RN(LL+6)=R+4
CN	GO TO 47
CN647	CONTINUE

CN	R7=RN(LL+7)
CN	R9=R-RN(LL+3)+(R8+1.)*2.
CN	IF(R9.GT.7)GO TO 47
C  NO WORK NEEDED.  IT'S LONG ENOUGH
CN	IF(RN(LL).GT.5)RN(LL+8)=-1
CN	R=1.
CN	IF(R7.LT.0)R=-R
CN547	RN(LL+4)=RN(LL+4)+R
CN	RN(LL+5)=RN(LL+5)+R
C  WERE +AA ↑↑↑↑↑
CN	RN(LL+7)=R
CN	GO TO 47
1047	IF(AA.NE.6)GO TO 47
	IF(RN(LL).LT.7)GO TO 47
	IF(RN(LL+9).GT.200.)RN(LL+9)=0
C ********** FIX THIS IN GETPTS, MOVER.  IT SHOULDN'T MOVE P9 ALWAYS.
47	CONTINUE

2	KWDS(KP)=JPQ
CP	J=1
	IF(KP.GE.250.OR.JPQ.GE.2000)TYPE 20,KP,JPQ
	JJ2=KP+1
C  WRITES 1 EXTRA WORD
CP	JPQ=KB

	DO 12 K=1,KP
CC	N=KWDS(K)
CC	R=RN(N+1)
	R=CODEN(KWDS,K,RN,N)
	IF(R.LE.2)GO TO 22
C  ONCE IT FINDS A REST OR NOTE IT MUST HAVE GONE TOO FAR.
	IF(R.GT.7)GO TO 12
 	IF(R.EQ.5)GO TO 52
	IF(R.NE.4)GO TO 62
	IF(RN(N).GE.4)GO TO 52
62	IF(R.NE.7)GO TO 12
52	A=RN(N+6)
C J HAS NOTE COUNT TO FIND POS OF RIGHT END OF SLUR.
	IF(A.GE.0)GO TO 12
	J=A
	IF(J.EQ.0)J=-1
	B=RN(N+2)
C  B=STAFF NUM.
	JJ=0

	DO 32 KK=K+1,KP
CC	NN=KWDS(KK)
CC	A=RN(NN+1)
	A=CODEN(KWDS,KK,RN,NN)
	IF(A.NE.1)GO TO 32
	IF(B.NE.RN(NN+2))GO TO 32
	D=RN(NN+3)
	JJ=JJ-1
	IF(J.NE.JJ)GO TO 42
	RN(N+6)=D+(D-A)*(RN(N+6)-J)
C FOUND NOTE FOR POSITION.
	GO TO 12
42	A=D
32	CONTINUE
12	CONTINUE
	
22	CALL PUTEXT(NAMX,EXT)
	LCNT=0
	NDPY=0
	RSTFAC(96)=0
C  MUST BE 0 IN MS TO MAKE DISPLAY
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(KWDS,JJ2)
	CALL EXTOUT(RN,JPQ)
	TYPE 101,NAMX,EXT
	NAMX=NAMX+2
CC	IF(IPG)GO TO 6011
	NPG=NPG+1
	IF(NPG.LE.MPG)GO TO 6011
	NPG=1
C RESET, UPDATE FILENAMES
	NAMX=NAMZ+256
	NAMZ=NAMX
6011	NAMQ=NAMX
	CALL FINEXT
	GO TO 100
C IPG=1  = GO BACK TO TRONLY INSTEAD
101	FORMAT(1XA5,'.',A3)
20	FORMAT(' TOO MUCH DATA!!! ',I3,'/250',I5,'/2000')
	END

	SUBROUTINE NAMEXT
	COMMON /SF/KL,RT,KP,STFSZ,NAME,EXT
	COMMON RS,JA,CLEFQ,AA,RQ(6),I(10),KQ,NQ,JQ,JJQ,KBQ,NAQ
11	TYPE 12
	ACCEPT 1,I
	DO 2 K=2,6
	IF(I(K).EQ.' ')GO TO 3
2	IF(I(K).EQ.'.')GO TO 4
	TYPE 10
	GO TO 11
10	FORMAT(' 5 LTR NAME + EXT ONLY'/)
12	FORMAT(' TYPE FILE NAME -- '$)
3	REREAD 99,NAME
	RETURN
4	GO TO(1,5,6,7,8,9),K
1	FORMAT(10A1)
55	FORMAT(2A1,A3)
66	FORMAT(A2,A1,A3)
77	FORMAT(A3,A1,A3)
88	FORMAT(A4,A1,A3)
99	FORMAT(A5,A1,A3)
5	REREAD 55,NAME,K,EXT
	RETURN
6	REREAD 66,NAME,K,EXT
	RETURN
7	REREAD 77,NAME,K,EXT
	RETURN
8	REREAD 88,NAME,K,EXT
	RETURN
9	REREAD 99,NAME,K,EXT
	END